;; collection/stream.scm - (c) rohan drape, 2000-2005

;; Stream operations in SRFI-40/41 but not in draft implementation.

(define (stream-unfoldn gen seed n)
  (define (unfold-result-stream gen seed)
    (let loop ((seed seed))
      (call-with-values
          (lambda () (gen seed))
	(lambda (next . results)
	  (stream-cons results (loop next))))))
  (define (result-stream->output-stream result-stream i)
    (let ((result (ref (stream-car result-stream) i)))
      (cond ((pair? result)
	     (stream-cons (car result)
			  (result-stream->output-stream
                               (stream-cdr result-stream) i)))
	    ((not result)
	     (result-stream->output-stream (stream-cdr result-stream) i))
	    ((null? result) stream-null)
	    (else (error "stream-unfoldn: can't happen")))))
  (define (result-stream->output-streams result-stream n)
    (let loop ((i 0) (outputs '()))
      (if (= i n)
        (apply values (reverse outputs))
        (loop (+ i 1)
              (cons (result-stream->output-stream result-stream i)
                    outputs)))))
  (result-stream->output-streams (unfold-result-stream gen seed) n))

;; Aliases for SRFI-40/41 procedures.

(define-syntax define-stream
  (syntax-rules ()
    ((_ a ...) 
     (stream-define a ...))))

;; Stream variants of R5RS/SRFI-1 list operations.

(define-stream (stream-iota n start step)
  (if (= n 0)
      stream-null
      (stream-cons start (stream-iota (- n 1) (+ start step) step))))

(define-stream (stream-tail stream index)
  (if (zero? index)
      stream
      (stream-tail (stream-cdr stream) (- index 1))))

;; Stream utilities not in SRFI-40/41.  

;; Math operations on streams.

(define (make-stream-binary-operator op)
  (define-stream (f a b)
    (if (or (stream-null? a)
	    (stream-null? b))
	stream-null
	(stream-cons (op (stream-car a) (stream-car b))
		     (f (stream-cdr a) (stream-cdr b)))))
  f)

(define (make-stream-nary-operator op)
  (define b (make-stream-binary-operator op))
  (define-stream (f . v)
    (case (length v)
      ((0) stream-null)
      ((1) (stream-map op (car v)))
      ((2) (b (car v) (cadr v)))
      (else (b (car v) (apply f (cdr v))))))
  f)

(define stream-+ (make-stream-nary-operator +))
(define stream-- (make-stream-nary-operator -))
(define stream-* (make-stream-nary-operator *))
(define stream-/ (make-stream-nary-operator /))

;; Evaluates to an infite stream having as every element `object'.

(define (value->stream a)
  (stream-cons a (value->stream a)))

;; Count the elements at s.  Diverges if s is not finite.

(define (stream-length s)
  (let loop ((n 0)
	     (s s))
    (if (stream-null? s)
	n
	(loop (+ n 1) (stream-cdr s)))))

;; Evaluates to an infinite stream of integers starting at `n'.

(define-stream (stream-of-integers n)
  (stream-cons n (stream-of-integers (+ n 1))))

;; Apply the procedure known as the sieve of Eratosthenes to `stream'.
;; Applied to the stream of integers startiong at two this provides the
;; series of prime numbers.

(define-stream (stream-sieve-of-eratosthenes stream)
  (stream-cons (stream-car stream)
	       (stream-sieve-of-eratosthenes 
		(stream-filter
		 (lambda (x)
		   (not (zero? (remainder x (stream-car stream)))))
		 (stream-cdr stream)))))

;; Evaluates to '#t' iff `n' is a prime number.  This procedure is
;; defined in terms of the infinite stream of prime numbers
;; 'stream-of-primes', which in turn is defined in terms of this
;; procedure.  This is the clever recursive definition given in SICP.

(define (prime? n)
  (letrec ((iter (lambda (ps)
		   (cond ((> (square (stream-car ps)) n) #t)
			 ((zero? (remainder n (stream-car ps))) #f)
			 (else (iter (stream-cdr ps)))))))
    (iter (stream-of-primes))))

;; Evaluate to the infinite stream of prime numbers.

(define-stream (stream-of-primes)
  (stream-cons 2
	       (stream-filter prime?
			      (stream-of-integers 3))))
